home *** CD-ROM | disk | FTP | other *** search
- Unit Icon;
- { }
- { Turbo Vision "Icons" }
- { }
- { This unit implements an icon object for Turbo Vision. These are small }
- { views containing simple text and are intended to be inserted into the }
- { Application (as opposed to the DeskTop) so that they float "on top" }
- { of everything else. They also cannot be moved out of sight except by }
- { covering one with another. TIcon defines a DoubleClick method that }
- { is called whenever a mouse double-click event occurs. By default, it }
- { does nothing - override it to provide whatever function you want, }
- { such as opening more windows, dialogs and so on. }
- { }
- { TIcon supports highlighting of its text (using ~ characters), but }
- { does NOT respond in any way to keyboard events and cannot be selected.}
- { In my applications, I use it as a mouse-only alternative to menu }
- { selections. TIcons can be moved by dragging with a mouse and can be }
- { loaded and stored, though you must call RegisterIcon before you use }
- { them in streams. The text displayed in the icon is supplied in the }
- { Init call and will be crudely fitted into as many lines as will fit }
- { in the Bounds. An enhanced version could, for example, work more like }
- { TStaticText and do centering, line-breaks and so on. }
- { }
- { This code is released into the Public Domain and may be used for any }
- { purpose. If you have comments or questions, I can be reached at: }
- { }
- { David Babler (Orion Digital Systems) }
- { CIS: 75076,1204 }
- { BBS: 206 693-5365 Voice: 206 892-3612 }
- { }
-
- INTERFACE
- Uses
- Drivers,
- Objects,
- Views;
-
- Type
- PIcon = ^TIcon;
- TIcon = Object (TView)
- Title : PString;
-
- Constructor Init (var Bounds : TRect; Const ATitle : string);
- Constructor Load (var S : TStream);
- Destructor Done;
- virtual;
- Procedure Store (var S : TStream);
- virtual;
- Procedure Draw;
- virtual;
- Procedure HandleEvent (var Event : TEvent);
- virtual;
- Procedure DoubleClick;
- virtual;
- end;
-
- Procedure RegisterIcon;
-
- IMPLEMENTATION
-
- Uses
- Dialogs,
- Strings;
-
- Const
- RIcon : TStreamRec =
- (ObjType: 9000;
- VmtLink: Ofs(TypeOf(TIcon)^);
- Load: @TIcon.Load;
- Store: @TIcon.Store);
-
- {--- TICon's Methods ---}
-
- Constructor TIcon.Init (var Bounds : TRect; Const ATitle : string );
- begin
- Inherited Init(Bounds);
- DragMode := dmLimitAll;
- SetState(sfShadow,true);
- Title := NewStr(ATitle);
- end;
-
- Constructor TIcon.Load (var S : TStream);
- begin
- Inherited Load(S);
- Title := S.ReadStr;
- end;
-
- Destructor TIcon.Done;
- begin
- DisposeStr(Title);
- Inherited Done;
- end;
-
- Procedure TIcon.Store (var S : TStream);
- begin
- Inherited Store(S);
- S.WriteStr(Title);
- end;
-
- Procedure TIcon.Draw;
- Var
- B : TDrawBuffer;
- C : Word;
- begin
- C := GetColor($6766);
- MoveChar(B,' ',C,Size.X * Size.Y);
- MoveCStr(B[1],Title^,C);
- WriteBuf(0,0,Size.X,Size.Y,B);
- end;
-
- Procedure TIcon.HandleEvent (var Event : TEvent);
- Var
- R : TRect;
- Min,Max : TPoint;
- begin
- Inherited HandleEvent(Event);
-
- if Event.What and evMouseDown = evMouseDown then
- begin
- if Event.Double then DoubleClick
- else begin
- Owner^.GetExtent(R);
- R.Grow(0,-1);
- SizeLimits(Min,Max);
- DragView(Event,dmDragMove or DragMode,R,Min,Max);
- ClearEvent(Event);
- end;
- end;
- end;
-
- Procedure TIcon.DoubleClick;
- begin
- { override to perform specific action on double-click }
- end;
-
- Procedure RegisterIcon;
- begin
- RegisterType(RIcon);
- end;
-
-
- end.